home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS02.ADF / ABasicStuff / supersphere.bas < prev    next >
BASIC Source File  |  1989-05-30  |  3KB  |  98 lines
  1. 1000  ' SuperSphere Version 1.0 - - - - - 12/06/85
  2. 1100  ' By Kelly Kauffman
  3. 1200  ' 
  4. 1300  ' This program is derived from the original Atari 8-bit version,
  5. 1400  ' and the Amiga translation.  The program runs considerably faster
  6. 1500  ' due to the extensive use of the "Circle" command, rather than
  7. 1600  ' putting points in arrays and drawing lines connecting them.  The
  8. 1700  ' circles are also much rounder.
  9. 1800  '
  10. 1900  ' There is a bug in the "Circle" command that is demonstrated on the
  11. 2000  ' small "planets," at least that is when it is most noticeable.  It
  12. 2100  ' jets out a bit (to alot) from the circle, leaving you with big-ole
  13. 2200  ' lines outside of your "planet."  I can't figure out how to get rid
  14. 2300  ' of 'em, so if you do, please upload it so everyone can have your
  15. 2400  ' fix.  Please leave my name on this, as I have worked VERY HARD in
  16. 2500  ' getting the formulas to work correctly....Thanx!!!
  17. 2600  ' 
  18. 2700  ' Hold down the left mouse button, while the program is running
  19. 2800  ' to exit.  Make sure you hold it down---it may take a second.
  20. 2900  '
  21. 3000  '
  22. 3100  '
  23. 3200  '
  24. 3300  '
  25. 3400  '
  26. 3500  randomize -1
  27. 3600  screen 0,4
  28. 3700  rgb 0,0,0,0:rgb 15,0,0,0
  29. 3800  rgb 1,10,10,10
  30. 3900  rgb 3,15,6,0:rgb 9,0,0,15
  31. 4000  rgb 10,3,6,15:rgb 11,7,7,15
  32. 4100  rgb 12,12,0,14:rgb 13,15,2,14
  33. 4200  gosub 8700:gosub 8500
  34. 4300  scnclr
  35. 4400  peno 2
  36. 4500  a=2
  37. 4600  gosub 6500
  38. 4700  str=(hi/100)*5:a=int(rnd*14):for i=1 to 19
  39. 4800  a=a+1:if a>14 then a=2
  40. 4900  peno a
  41. 5000  hi=hi-str
  42. 5100  circle (x,y),wide,hi/wide
  43. 5200  next i
  44. 5300  return
  45. 5400  goto 6400
  46. 5500  str=(hi/100)*5
  47. 5600  a=int(rnd*14)
  48. 5700  for i=1 to 19
  49. 5800  a=a+1:if a>14 then a=2
  50. 5900  peno a
  51. 6000  hi=hi-str
  52. 6100  circle (x,y),hi,wide/hi
  53. 6200  next i
  54. 6300  return
  55. 6400  rem end
  56. 6500  rem
  57. 6600  wide=rnd*100
  58. 6700  x=rnd*385
  59. 6800  y=rnd*190
  60. 6900  hi=wide
  61. 7000  ask mouse x%,y%,b%:if b%=4 then 10400
  62. 7100  gosub 7600
  63. 7200  gosub 4700
  64. 7300  hi=wide
  65. 7400  gosub 5500
  66. 7500  goto 6500
  67. 7600  hig=hi
  68. 7700  hig=hi
  69. 7800  for i=1 to 100
  70. 7900  peno 0
  71. 8000  circle(x,y),wide,hig/wide
  72. 8100  hig=hig-1:if hig<1 then i=100
  73. 8200  next i
  74. 8300  pena 0:draw (x-wide,y to x+wide,y)
  75. 8400  return
  76. 8500  window 1,0,0,320,200,"SuperSphere V1.0 by Kelly Kauffman"
  77. 8600  cmd 1:return
  78. 8700  hi=180
  79. 8800  box (0,0;319,199),1
  80. 8900  x=151:y=90
  81. 9000  wide=180
  82. 9100  for i=1 to 100 step .5
  83. 9200  circle (x,y),wide,hi/wide
  84. 9300  a=a+1:if a>14 then a=2
  85. 9400  peno a
  86. 9500  pena a-1:outline 1:paint (x,y),1
  87. 9600  hi=hi-7
  88. 9700  if hi<1 then i=100
  89. 9800  next i
  90. 9900  drawmode 1:peno 1:pena 4:penb 2:graphic (1)
  91. 10000 ? at(100,80);inverse(1);" SuperSphere ";:penb 0:pena 9:? at(85,100);inverse(0);"by Kelly Kauffman"
  92. 10100 ask mouse x%,y%,b%
  93. 10200 if b%=0 then 10100
  94. 10300 return
  95. 10400 close 
  96. 10500 screen 0,4,0
  97. 10600 end
  98.